home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / nexttsrc.lha / nexttsources / sources / sys / read.t < prev    next >
Text File  |  1990-06-19  |  23KB  |  619 lines
  1. (herald read
  2.   (env tsys (osys buffer) (osys readtable)))
  3.  
  4.  
  5. ;;; Copyright (c) 1985 Yale University
  6. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, K Pitman, J Rees.
  7. ;;; This material was developed by the T Project at the Yale University Computer 
  8. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  9. ;;; and to use it for any purpose is granted, subject to the following restric-
  10. ;;; tions and understandings.
  11. ;;; 1. Any copy made of this software must include this copyright notice in full.
  12. ;;; 2. Users of this software agree to make their best efforts (a) to return
  13. ;;;    to the T Project at Yale any improvements or extensions that they make,
  14. ;;;    so that these may be included in future releases; and (b) to inform
  15. ;;;    the T Project of noteworthy uses of this software.
  16. ;;; 3. All materials developed as a consequence of the use of this software
  17. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  18. ;;;    of acknowledging credit in academic research.
  19. ;;; 4. Yale has made no warrantee or representation that the operation of
  20. ;;;    this software will be error-free, and Yale is under no obligation to
  21. ;;;    provide any services, by way of maintenance, update, or otherwise.
  22. ;;; 5. In conjunction with products arising from the use of this material,
  23. ;;;    there shall be no use of the name of the Yale University nor of any
  24. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  25. ;;;    without prior written consent from Yale in each case.
  26. ;;;
  27.  
  28. ;;;; external representation parser
  29.  
  30. ;;; the incredible reader.  it is here that the language's external syntax
  31. ;;; (such as it is) is definitively defined.
  32.  
  33. ;;; ---------- internal markers and tokens
  34.  
  35. (define (make-token id)                 
  36.   (object nil
  37.           ((print-type-string self) "Token")
  38.           ((identification self) id)))
  39.  
  40. ;;; class of markers for right brackets
  41.  
  42. (define close-token-marker (make-token 'close-token-marker))
  43.  
  44. (define-integrable (make-close-token)
  45.   (cons close-token-marker nil))
  46.  
  47. (define-integrable (close-token? x)
  48.   (and (pair? x) (eq? (car x) close-token-marker)))
  49.  
  50. ;;; token for dot syntax
  51.  
  52. (define dot-token (make-token 'dot-token))
  53.  
  54. (define-integrable (dot-token? x)
  55.   (eq? x dot-token))
  56.  
  57. ;;; nothing-read is the mechanism whereby readmacros can choose to not
  58. ;;; return anything.
  59.  
  60. (define nothing-read (make-token 'nothing-read))
  61.  
  62. (define-integrable (nothing-read? x)
  63.   (eq? x nothing-read))
  64.  
  65. ;;; ---------- top-level entries into reader
  66.  
  67. ;;; some of the following procedure names can be explained by
  68. ;;; imagining that an "object" is either an object read in the normal
  69. ;;; way or an eof token, and that a "thing" might include some strange
  70. ;;; internal reader token, like a dot or a close-bracket.
  71.  
  72. ;;; read-object is the default method for the read operation.
  73.  
  74. (define (read-object port read-table)
  75.   (read-object-1 port read-table nil))
  76.  
  77. ;;; recursive entry from readmacros.  this is guaranteed to return a useable
  78. ;;; value, no funny tokens of any sort.
  79.  
  80. (define (read-refusing-eof port)
  81.   (read-object-refusing-eof port (port-read-table port)))
  82.  
  83. (define (read-object-refusing-eof port rt)
  84.   (read-object-1 port rt t))
  85.  
  86. (define (read-object-1 port rt refuse-eofs?)
  87.   (iterate loop ()                      ; throw away bogus close tokens.
  88.     (let ((obj (read-thing-refusing-dots port rt)))
  89.       (cond ((eof? obj)
  90.              ;; eof's might or might not be returnable.
  91.              (cond (refuse-eofs?
  92.                     (read-error port "unexpected end-of-file"))
  93.                    (else obj)))
  94.             ((close-token? obj)
  95.              ;; right parentheses might or might not be ignorable.
  96.              (cond ((and (not refuse-eofs?) (interactive? port))
  97.                     (loop))
  98.                    (else
  99.                     (unread-char port)    ; incredible hack.
  100.                     (read-error port "unexpected \"~c\""
  101.                                 (read-char port)))))
  102.             (else
  103.              ;; object is neither eof nor close.  return it.
  104.              obj)))))
  105.  
  106. ;;; this is called from the list reader and from the two above routines.
  107.  
  108. (define (read-thing-refusing-dots port rt)
  109.   (let ((obj (read-thing port rt)))
  110.     (cond ((dot-token? obj)
  111.            (read-error port "\" . \" in illegal context"))
  112.           (else obj))))
  113.  
  114. ;;; ---------- main dispatch for reader
  115.  
  116. ;;; this is the place where the scanning and dispatching actually happens.
  117.  
  118. (define (read-thing port rt)
  119.   (iterate loop ()
  120.     (let ((ch (read-char port)))
  121.       (cond ((eof? ch) ch)
  122.             (else
  123.              (let ((syn (char-syntax rt ch)))
  124.                (cond ((read-macro? syn)
  125.                       (let ((obj (syn port ch rt)))
  126.                         (if (nothing-read? obj) (loop) obj)))
  127.                      (else
  128.                       (select syn
  129.                               ((%%whitespace %%ignored) (loop))
  130.                               (else (read-atom port rt ch)))))))))))
  131.  
  132. ;;; not readmacro, not whitespace: just a vanilla symbol or number.
  133.  
  134. (define (read-atom port rt ch)
  135.   (with-buffers ((buf))                 ; ought to bind this somehow
  136.     (iterate loop ((ch ch) (slashes? nil))
  137.       ((lambda (accum done)
  138.          (cond ((eof? ch) (done))
  139.                (else
  140.                 (let ((syn (char-syntax rt ch)))
  141.                   (cond ((not (read-macro? syn))
  142.                          (select syn
  143.                            ((%%constituent)
  144.                             (accum ((rt-translator rt) ch)
  145.                                    slashes?))
  146.                            ((%%whitespace)
  147.                             (unread-char port)    ; put back the delimiter
  148.                             (done))
  149.                            ((%%escape-char)
  150.                             (let ((ch (read-char port)))
  151.                               (if (eof? ch)
  152.                                   (read-error port
  153.                                               ;; elaborate on this...
  154.                                               "eof follows escape char")
  155.                                   (accum ch t))))
  156.                            ((%%undefined)
  157.                             (illegal-char-encountered port ch))
  158.                            (else
  159.                             (loop (read-char port) slashes?))))
  160.                         ((not (delimiting-read-macro? syn))
  161.                          (accum ((rt-translator rt) ch)
  162.                                 slashes?))
  163.                         (else 
  164.                          (unread-char port)    ; put back the delimiter
  165.                          (done)))))))
  166.        (lambda (ch slashes?)            ; accum
  167.          (vm-write-char buf ch)
  168.          (loop (read-char port) slashes?))
  169.        (lambda ()                       ; done
  170.          (let ((str (buffer->string buf)))
  171.            (cond (slashes?
  172.                   ((rt-string->symbol rt) str))
  173.                  (else
  174.                   (((rt-recognizer rt) str rt) str rt)))))))))
  175.  
  176. (define (illegal-char-encountered port ch)
  177.   (read-error port "illegal character ~s" ch))
  178.  
  179. ;;; create the standard read table.
  180.  
  181. (define standard-read-table
  182.   (make-read-table vanilla-read-table 'standard-read-table))
  183.  
  184. (set *print-table* standard-read-table)
  185.  
  186. (set-read-table-entry standard-read-table #\backslash %%escape-char)
  187.  
  188. (walk (lambda (ch)
  189.         (set-read-table-entry standard-read-table ch %%undefined))
  190.       '(#\left-brace #\right-brace #\left-bracket #\right-bracket))
  191.  
  192. ;;; ---------- standard read macros
  193.  
  194. (define (make-list-reader)
  195.   (let* ((token (make-close-token))
  196.          (right
  197.           (object (lambda (port ch rt)
  198.                     (ignore port ch rt)
  199.                     token)
  200.                   ((delimiting-read-macro? self) t)
  201.                   ((establish-read-table-entry self ch)
  202.                    (if (and (eq? self
  203.                                  (read-table-entry standard-read-table
  204.                                                    #\right-paren))
  205.                             (null? *list-end-char*))
  206.                        (set *list-end-char* ch)))
  207.                   ((print-type-string self) "List-terminator"))))
  208.     (object (lambda (port ch rt)
  209.               (ignore ch)
  210.               (read-delimited-list port token rt))
  211.             ((delimiting-read-macro? self) t)
  212.             ((establish-read-table-entry self ch)
  213.              (if (and (eq? self
  214.                            (read-table-entry standard-read-table
  215.                                              #\left-paren))
  216.                       (null? *list-begin-char*))
  217.                  (set *list-begin-char* ch)))
  218.             ((list-terminator self) right)
  219.             ((print-type-string self) "List-reader"))))
  220.  
  221. (define-operation (list-terminator syn))
  222.  
  223. (let ((reader (make-list-reader)))
  224.   (set-read-table-entry standard-read-table
  225.                         #\left-paren
  226.                         reader)
  227.   (set-read-table-entry standard-read-table
  228.                         #\right-paren
  229.                         (list-terminator reader)))
  230.  
  231. ;;; Used when something ends in wrong kind of token.  this is the
  232. ;;; place to implement super-brackets, if we ever decide that we
  233. ;;; want them.
  234.  
  235. (define (losing-right-bracket port)
  236.   (read-error port "right bracket doesn't match left bracket")
  237.   nothing-read)
  238.  
  239. (define (losing-eof port)
  240.   (read-error port "end of file inside list (missing right bracket)")
  241.   nothing-read)
  242.  
  243. (define (read-delimited-list port token rt)
  244.   (iterate loop ((l '()))
  245.     (let ((obj (read-thing port rt)))
  246.       (cond ((eof? obj) (losing-eof port))
  247.             ((close-token? obj)
  248.              ;; list ends with right paren
  249.              (cond ((neq? obj token)
  250.                     (losing-right-bracket port))
  251.                    (else (reverse! l))))
  252.             ((dot-token? obj)
  253.              (let ((tail (read-object-refusing-eof port rt)))
  254.                (let ((z (read-thing-refusing-dots port rt))) ;expect close.
  255.                  (cond ((eof? z) (losing-eof port))
  256.                        ((eq? z token)
  257.                         ;; list ends <.> <frob> <rparen>
  258.                         (append-reverse! l tail))
  259.                        ((close-token? z)
  260.                         (losing-right-bracket port))
  261.                        (else
  262.                         (read-error port "two objects follow dot in list"))
  263.                        ))))
  264.             (else (loop (cons obj l)))))))
  265.  
  266. (define read-delimited-string
  267.   (object (lambda (port ch rt)
  268.             (with-buffers ((buffer))
  269.               (read-delimited-string-into-buffer port ch rt buffer)
  270.               (buffer->string buffer)))
  271.           ((establish-read-table-entry self ch)
  272.            (if (null? *string-delimiter*)
  273.                (set *string-delimiter* ch)))))
  274.  
  275. (define (read-delimited-string-into-buffer port delimiter rt buffer)
  276.   (labels (((error)
  277.             (read-error port
  278.                         "end of file within ~c...~c (missing delimiter)"
  279.                         delimiter
  280.                         delimiter)
  281.             buffer)
  282.            ((read-escaped-char)
  283.             (let ((ch (read-char port)))
  284.               (cond ((eof? ch) (error))
  285.                     ((char= ch *control-char-delimiter*)
  286.                      (let ((ch (read-char port)))
  287.                        (if (eof? ch) (error) (%controlify ch))))
  288.                     ((char= ch #\left-bracket)
  289.                      (read-keyworded port ch 0 rt))
  290.                     (else ch))))
  291.           ((loop)
  292.            (let ((ch (read-char port)))
  293.              (cond ((eof? ch) (error))
  294.                    ((char= ch delimiter) buffer)
  295.                    (else
  296.                     (vm-write-char
  297.                      buffer
  298.                      (if (eq? (char-syntax rt ch) %%escape-char)
  299.                          (read-escaped-char)
  300.                          ch))
  301.                     (loop))))))
  302.     (loop)))
  303.  
  304. (set-read-table-entry standard-read-table #\doublequote read-delimited-string)
  305.  
  306. (define read-delimited-symbol
  307.   (object (lambda (port ch rt)
  308.             (with-buffers ((buffer))
  309.               (read-delimited-string-into-buffer port ch rt buffer)
  310.               (string->symbol (buffer->string! buffer))))
  311.           ((establish-read-table-entry self ch)
  312.            (if (null? *symbol-delimiter*) (set *symbol-delimiter* ch)))))
  313.  
  314. ;(set-read-table-entry standard-read-table #\| read-delimited-symbol)
  315.  
  316. (define read-comment
  317.   (object (lambda (port ch rt)
  318.             (ignore ch rt)
  319.             (let ((obj (read-line port)))
  320.               (if (eof? obj) obj nothing-read)))
  321.     ((delimiting-read-macro? self) t)))
  322.  
  323. (set-read-table-entry standard-read-table #\semicolon read-comment)
  324.  
  325. (define (read-quotation port ch rt)
  326.   (ignore ch)
  327.   (list 'quote (read-object-refusing-eof port rt)))
  328.  
  329. (set-read-table-entry standard-read-table #\quote read-quotation)
  330.  
  331. (define (read-backquote port ch rt)
  332.   (ignore ch)
  333.   (list 'quasiquote (read-object-refusing-eof port rt)))
  334.  
  335. (set-read-table-entry standard-read-table #\backquote read-backquote)
  336.  
  337. (define (read-comma port ch rt)
  338.   (ignore ch)
  339.   (list (cond ((char= (peek-char port) #\@)
  340.                (read-char port)
  341.                'unquote-splicing)
  342.               (else 'unquote))
  343.         (read-object-refusing-eof port rt)))
  344.  
  345. (set-read-table-entry standard-read-table #\comma read-comma)
  346.  
  347. ;;; ---------- sharpsign
  348.  
  349. (define (make-dispatch-read-macro)
  350.   (make-dispatch-read-macro-1 (vector-fill (make-vector number-of-char-codes)
  351.                                            nil)))
  352.  
  353. (define (make-dispatch-read-macro-1 dispatch-table)
  354.   (object (lambda (port ch rt)
  355.             (let ((nextch (read-char port)))
  356.               ;; should read a number here, for #nrfoo.
  357.               (let ((fn (vref dispatch-table (char->ascii nextch))))
  358.                 (cond (fn (fn port nextch nil rt))
  359.                       (else (read-error port
  360.                                         "\"~c\" is an unknown ~c dispatch"
  361.                                         nextch ch))))))
  362.           ((dispatch-syntax self ch)
  363.            (vref dispatch-table (char->ascii ch)))
  364.           ((set-dispatch-syntax self ch fn)
  365.            (cond ((lowercase? ch)
  366.                   (set (vref dispatch-table
  367.                              (char->ascii (char-upcase ch)))
  368.                         fn))
  369.                  ((uppercase? ch)
  370.                   (set (vref dispatch-table
  371.                              (char->ascii (char-downcase ch)))
  372.                         fn))
  373.                  ((digit? ch 10.)
  374.                   (error "can't set a digit's dispatch-macro syntax")))
  375.            (set (vref dispatch-table (char->ascii ch)) fn))
  376.           ((establish-read-table-entry self ch)
  377.            (if (null? *dispatch-char*) (set *dispatch-char* ch)))
  378.           ((copy-read-table-entry self)
  379.            (make-dispatch-read-macro-1 (copy-vector dispatch-table)))
  380.           ((dispatcher? self) t)))
  381.  
  382. (define-settable-operation (dispatch-syntax table ch))
  383. (define set-dispatch-syntax (setter dispatch-syntax))
  384. (define-operation (copy-dispatcher table))
  385. (define-predicate dispatcher?)
  386.  
  387. (define read-dispatch (make-dispatch-read-macro))
  388.  
  389. (set-read-table-entry standard-read-table #\# read-dispatch)
  390.  
  391. ;;; #\c, #\foo - funny character reader
  392.  
  393. (define (read-character port ch n rt)
  394.   (ignore n)
  395.   (let ((q (peek-char port)))
  396.     (cond ((alphabetic? q)
  397.            (let ((probe (read-object port rt)))
  398.              (cond ((not (symbol? probe))
  399.                     (read-error port
  400.                                 "utter randomness in read-character - read ~s"
  401.                                 probe))
  402.                    ((fx= (symbol-print-length probe) 1) q)
  403.                    ((name-char probe))
  404.                    (else (read-error port "#~c~s: unknown #~c form"
  405.                                      ch probe ch)))))
  406.           (else (read-char port)))))
  407.  
  408. (set-dispatch-syntax read-dispatch #\\ read-character)
  409.  
  410. ;;; #t, #f - true and false
  411.  
  412. (set-dispatch-syntax read-dispatch #\t true)
  413. (set-dispatch-syntax read-dispatch #\f false)
  414.  
  415. ;;; canonical true and false
  416.  
  417. ;++ flush READ-DELIMITED-CONSTANT  and associated #!...
  418. (define (read-delimited-constant port ch n rt)
  419.   (ignore ch)
  420.   (ignore n)
  421.   (let* ((ch (readc port))
  422.          (token (read-atom port rt ch)))
  423.     (case token
  424.       ((true)           '#t)
  425.       ((false)          '#f)
  426.       ((null)           '())
  427.       ((quasiquote)     'quasiquote)
  428.       ((unquote)        'unquote)
  429.       ((unquote-splice) 'unquote-splicing)
  430.       (else
  431.        (read-error port "#!~s: unknown constant" token)))))
  432.  
  433. (set-dispatch-syntax read-dispatch #\! read-delimited-constant)
  434.  
  435. ;;; #b nnn, #o nnn, #x nnn - alternate radices
  436.  
  437. (define (make-radical-reader radix)
  438.   (lambda (port ch n rt)
  439.     (ignore ch n)
  440.     (read-object-refusing-eof port (rt-with-radix rt radix))))
  441.  
  442. (set-dispatch-syntax read-dispatch #\b (make-radical-reader 2))
  443.  
  444. (set-dispatch-syntax read-dispatch #\o (make-radical-reader 8))
  445.  
  446. (set-dispatch-syntax read-dispatch #\x (make-radical-reader 16))
  447.  
  448. (set-dispatch-syntax read-dispatch #\r
  449.                      (lambda (port ch n rt)
  450.                        (ignore ch)
  451.                        (read-object-refusing-eof port
  452.                                                  (rt-with-radix rt n))))
  453.  
  454. ;;; #^x - control character
  455.  
  456. (set-dispatch-syntax read-dispatch *control-char-delimiter*
  457.                      (lambda (port ch n rt)
  458.                        (ignore ch n rt)
  459.                        (controlify (read-char port))))
  460.  
  461. ;;; #(a b c ...) - vector syntax
  462. ;;; extremely kludgey definition
  463.  
  464. (define (read-vector port ch n rt)
  465.   (ignore n)
  466.   (list->vector ((read-table-entry standard-read-table #\left-paren)
  467.                  port ch rt)))
  468.  
  469. (set-dispatch-syntax read-dispatch #\left-paren read-vector)
  470.  
  471. ;;; #[keyword stuff ...] - general rereadable object.
  472. ;;; The entries in the READ-KEY-WORD table are procedures
  473. ;;; of 3 arguments, (lambda (key port read-table) ...) 
  474. ;;; where KEY is the keyword, PORT is the port being
  475. ;;; read, and READ-TABLE is the read-table being used to
  476. ;;; read from the port.  STUFF in #[key stuff ...] will
  477. ;;; not have been read yet.
  478.  
  479. (define read-keyword-table (make-table 'read-keyword-table))
  480.  
  481. (set (rt-keyword-table standard-read-table) read-keyword-table)
  482.  
  483. (define read-to-right-bracket (make-list-reader))
  484.  
  485. (set-read-table-entry standard-read-table #\right-bracket
  486.                       (list-terminator read-to-right-bracket))
  487.  
  488. (define (read-keyworded port ch n rt)
  489.   (ignore n ch)
  490.   (let ((key (read-thing port rt)))
  491.     (cond ((table-entry (rt-keyword-table rt) key)
  492.            => (lambda (proc) (proc key port rt)))
  493.           (else
  494.            (read-error port "unknown #[...] syntax: #[~s ...]" key)))))
  495.  
  496. (set-dispatch-syntax read-dispatch #\[ read-keyworded)
  497.  
  498. (define (read-ascii key port rt)
  499.   (let ((error (lambda (n)
  500.                  (read-error port "illegal syntax - #[ascii ~s]" n)))
  501.         (l (read-to-right-bracket port #\] rt)))
  502.     (if (not (null? (cdr l))) (error (cdr l)))
  503.     (let ((n (car l)))
  504.       (cond ((and (symbol? n) (name-char n)))
  505.             ((and (fixnum? n)
  506.                   (not (fx< n 0))
  507.                   (not (fx>= n number-of-char-codes))
  508.                   (ascii->char n)))
  509.             (else (error n))))))
  510.  
  511. (set (table-entry read-keyword-table 'char)  read-ascii)
  512. (set (table-entry read-keyword-table 'ascii) read-ascii)
  513.  
  514. ;;; #[Symbol ...]
  515.  
  516. (set (table-entry read-keyword-table 'symbol)
  517.       (lambda (key port rt)
  518.         (ignore key) 
  519.         (string->symbol (car (read-to-right-bracket port #\] rt)))))
  520.  
  521. ;;; #[Text ...]
  522.  
  523. (set (table-entry read-keyword-table 'text)
  524.       (lambda (key port rt) 
  525.         (ignore key) 
  526.         (let ((l (read-to-right-bracket port #\] rt)))   
  527.           (string-text (cadr l)))))
  528.  
  529. ;;; #[Bytev ...]
  530.  
  531. (set (table-entry read-keyword-table 'bytev) 
  532.      make-bytev-for-read)
  533.  
  534. ;;; #[Filename ...] 
  535.  
  536. (set (table-entry read-keyword-table 'filename) 
  537.      make-filename-for-read)
  538.  
  539. ;;; #[Syntax ...] and #[Internal-syntax ...]
  540.  
  541. (define (read-syntax-descriptor key port rt)
  542.   (let* ((l (read-to-right-bracket port #\] rt))
  543.          (sym (car l)))
  544.     (cond ((or (not (null? (cdr l)))
  545.                (not (symbol? sym)))
  546.            (read-error port "illegal syntax - #[syntax ~s]" sym))
  547.           ((xcase key
  548.                   ((syntax)
  549.                    (syntax-table-entry standard-syntax-table sym))
  550.                   ((internal-syntax)    ;insufficient error checking
  551.                    (*value t-implementation-env sym))))
  552.           (else
  553.            (read-error port
  554.                        "not a standard reserved word - #[Syntax ~s]"
  555.                        sym)))))
  556.  
  557. (set (table-entry read-keyword-table 'syntax)
  558.      read-syntax-descriptor)
  559.  
  560. (set (table-entry read-keyword-table 'internal-syntax)
  561.      read-syntax-descriptor)
  562.  
  563. ;;; #[Comex ...]
  564.  
  565. (set (table-entry read-keyword-table 'comex)
  566.      (lambda (key port rt)
  567.        (ignore key rt)
  568.        (read-comex port)))
  569.  
  570.  
  571. ;;; #.expression - read-time evaluation
  572.  
  573. (set-dispatch-syntax read-dispatch #\.  ; bletch!  what to do?
  574.                      (lambda (port ch n rt)
  575.                        (ignore ch n)
  576.                        (eval (read-object-refusing-eof port rt)
  577.                              (make-locale standard-env '\#.))))
  578.  
  579. ;;; #|...|# reads as a comment
  580.  
  581. (define (read-inline-comment port ch n rt)
  582.   (ignore ch n rt)
  583.   (let ((readc (if (iob? port) vm-read-char read-char)))
  584.     (labels (((error)
  585.               (read-error port "end of file within #|...|# (missing delimiter)"))
  586.              ((loop level)
  587.               (let ((ch (readc port)))
  588.                 (cond ((eof? ch) (error))
  589.                       ((char= ch #\|)
  590.                        (let ((ch (readc port)))
  591.                          (cond ((eof? ch) (error))
  592.                                ((charn= ch #\#)
  593.                                 (unread-char port)
  594.                                 (loop level))
  595.                                ((fx= level 1)
  596.                                 nothing-read)
  597.                                (else
  598.                                 (loop (fx- level 1))))))
  599.                       ((char= ch #\#)
  600.                        (let ((ch (readc port)))
  601.                          (cond ((eof? ch) (error))
  602.                                ((char= ch #\|)
  603.                                 (loop (fx+ level 1)))
  604.                                (else
  605.                                 (unread-char port)
  606.                                 (loop level)))))
  607.                       (else (loop level))))))
  608.       (loop 1))))
  609.  
  610. (set-dispatch-syntax read-dispatch #\| read-inline-comment)
  611.  
  612.  
  613. ;;; ## reads as (car (repl-results)).  experimental feature.
  614.  
  615. (set-dispatch-syntax read-dispatch #\#
  616.                      (always '(car (repl-results))))
  617.  
  618. (set-immutable standard-read-table)
  619.